home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / tspa3540.zip / TSUNTD.INT < prev    next >
Text File  |  1996-09-07  |  7KB  |  167 lines
  1. {$B-,D-,F-,I+,N-,R-,S+,V+}
  2.  
  3. (*
  4. Timo Salmi UNiT D
  5. A Turbo Pascal unit for string manipulation and so on.
  6. All rights reserved 2-Aug-89,
  7. Updated 3-Aug-89, 19-Aug-89, 26-Sep-89, 13-Jun-90, 15-Jul-90, 5-Jan-91
  8.  
  9. This unit contains mainly string manipulation routines. There is not anything
  10. novel about the string routines. Just that I have tried to make them compact
  11. and fast. No inline code, though, is involved in this (nor the other) units.
  12. Well, starting from the 15-Jul-90 release (in tspas20.arc) this no longer
  13. holds. I have tried to upderstand some assembler and have included also
  14. inline code. Be warned that I cannot give any guarantees that the inline
  15. coded routines won't cause confusion.  Where inline code has been used,
  16. I have stated so.
  17.  
  18. This unit may be used and distributed freely for PRIVATE, NON-COMMERCIAL,
  19. NON-INSTITUTIONAL purposes, provided it is not changed in any way, and
  20. that a proper attribution is made. For ANY other usage, such as use in a
  21. business enterprise or at a university, contact the author for the terms
  22. of registration.
  23.  
  24. The units are under development. Comments and contacts are solicited. If
  25. you have any feedback about this unit, please do not hesitate to use
  26. electronic mail for communication.
  27.  
  28. The author shall not be liable to the user for any direct, indirect or
  29. consequential loss arising from the use of, or inability to use, any unit,
  30. program or file howsoever caused. No warranty is given that the units and
  31. programs will work under all circumstances.
  32.  
  33. Timo Salmi (email: ts@uwasa.fi WWW: http://uwasa.fi/~ts/)
  34. Professor of Accounting and Business Finance
  35. Faculty of Accounting & Industrial Management
  36. University of Vaasa
  37. P.O. BOX 700, FIN-65101 Vaasa, Finland
  38. *)
  39.  
  40. unit TSUNTD;
  41.  
  42. (* ======================================================================= *)
  43.                           interface
  44. (* ======================================================================= *)
  45.  
  46. uses Dos;
  47.  
  48. (* =======================================================================
  49.                    String handling routines
  50.    ======================================================================= *)
  51.  
  52. (* Trim a string right *)
  53. function TRIMRGFN (original : string; atcolumn : byte) : string;
  54.  
  55. (* Trim a string left *)
  56. function TRIMLFFN (original : string; atcolumn : byte) : string;
  57.  
  58. (* Lead a string with a suitable number of chosen characters *)
  59. function LEADFN (original     : string;
  60.                  total_length : byte;
  61.                  leadwith     : char) : string;
  62.  
  63. (* Trail a string with a suitable number of chosen characters *)
  64. function TRAILFN (original     : string;
  65.                   total_length : byte;
  66.                   trailwith    : char) : string;
  67.  
  68. (* The opposite of Turbo Pascal's own UpCase function. This one is inline
  69.    coded so that it should be fast. *)
  70. function LOWCASFN (ch : char) : char;
  71.  
  72. (* =======================================================================
  73.                    String parsing routines
  74.    ======================================================================= *)
  75.  
  76. const parse_parts_max   = 255;
  77. type parseVectorType    = array [1..parse_parts_max] of string;
  78.      parseVectorPtrType = ^parseVectorType;
  79.  
  80. (* Extract all substrings from a string *)
  81. procedure PARSE
  82.   (original          : string;
  83.    parse_parts_max   : integer;
  84.    separators        : string;
  85.    var nber_of_parts : integer;
  86.    var partPtr       : parseVectorPtrType;
  87.    var ok            : boolean);          {no errors detected}
  88.  
  89. (* This, and the following function, are alternatives to the PARSE procedure.
  90.    STRCNTFN and SPARTFN resemble more closely the inbuilt ParamCount and
  91.    ParamStr function. They do not require using pointers as PARSE does.
  92.    These two functions first appear in release tspas14.arc.
  93.    The purpose of STRCNTFN is to return the number of substrings in a string.
  94.    This is "the second generation" of my string parsers.
  95. *)
  96. function STRCNTFN (s : string; separators : string) : integer;
  97.  
  98. (* Returns the specified substring in a string *)
  99. function SPARTFN (s          : string;
  100.                   separators : string;
  101.                   PartNumber : integer) : string;
  102.  
  103. (* Number of substrings in a string.
  104.    This is "the third generation" of my string parsers.
  105.    This is much faster and more concise, but it uses all the ascii
  106.    characters below ascii 33 as separators, that is, there is no choice *)
  107. function PARSENFN (sj : string) : integer;
  108.  
  109. (* Get a substring from a string.
  110.    Returns '' if PartNumber is out of range.
  111.    This is "the third generation" of my string parsers.
  112.    This is much faster and more concise, but it uses all the ascii
  113.    characters below ascii 33 as separators, that is, there is no choice *)
  114. function PARSERFN (sj : string; PartNumber : integer) : string;
  115.  
  116. (* =======================================================================
  117.                       Crt replacements
  118.    ======================================================================= *)
  119.  
  120. (*
  121. Turbo Pascal's own units may occasionally cause problems when run on
  122. poorly compatible computers. In particular, the Ctr unit is problematic
  123. in this respect. The dosdelay procedure is a replacement of Turbo Pascal's
  124. own Delay procedure which is in the Crt unit. The accuracy of dosdelay
  125. is not as good as Delay's. Another reason for avoiding Crt is the potential
  126. problems if the program uses redirection.
  127. *)
  128. procedure DOSDELAY (milliseconds : word);
  129.  
  130. (*
  131. AUDIO is a replacement and enhancement of Turbo Pascal's sound procedure.
  132. AUDIO does not need the Crt unit, and it takes the duration of the sound
  133. as a parameter in milliseconds. This procedure first appears in release
  134. tspas19 of this collection. AUDIO has been written in collaboration with
  135. Ari Hovila, ajh@chyde.uwasa.fi.
  136. *)
  137. procedure AUDIO (frequency : longint; duration : word);
  138.  
  139. (* =======================================================================
  140.                   What about the printer
  141.    ======================================================================= *)
  142.  
  143. (* Is the parallel printer online. This works for the printers I have, but
  144.    there are differences in computer-printer configurations which may
  145.    affect this function. In fact, I've now found configurations where
  146.    this test fails and I've written an alternative method which is below *)
  147. function PRTONLFN : boolean;
  148.  
  149. (* Is the first (lpt1) printer online. An alternative for cases where prtonln
  150.    fails. Elicits a very quick response directly from the printer I/O *)
  151. function LPTONLFN : boolean;
  152.  
  153. (* Send the current screen to printer. First check the printer status. *)
  154. procedure PRTSCR;
  155.  
  156. (* Get the number of times I/O is attempted for the printer in the first
  157.    parallel port before an error condition arises. The default is normally
  158.    20 times. (As you know I/O errors can be trapped with IORresult if I/O
  159.    checking has been turned off using the $I- compiler directive. *)
  160. function GETPRTFN : byte;
  161.  
  162. (* Set the number of times I/O is attempted to the printers for all the
  163.    parallel ports before an error condition arises. If the argument
  164.    is zero, the ports are not reset *)
  165. procedure SETPRT (NumberOfRetrys : byte);
  166.  
  167.